home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-01 / ue312src.zip / EVAL.C < prev    next >
C/C++ Source or Header  |  1993-04-21  |  37KB  |  1,477 lines
  1. /*    EVAL.C: Expresion evaluation functions for
  2.         MicroEMACS
  3.  
  4.     written 1993 by Daniel Lawrence             */
  5.  
  6. #include    <stdio.h>
  7. #include    "estruct.h"
  8. #include    "eproto.h"
  9. #include    "edef.h"
  10. #include    "elang.h"
  11. #include    "evar.h"
  12.  
  13. VOID PASCAL NEAR varinit()    /* initialize the user variable list */
  14.  
  15. {
  16.     register int i;
  17.  
  18.     for (i=0; i < MAXVARS; i++)
  19.         uv[i].u_name[0] = 0;
  20. }
  21.  
  22. VOID PASCAL NEAR varclean()    /* initialize the user variable list */
  23.  
  24. {
  25.     register int i;
  26.  
  27.     for (i=0; i < MAXVARS; i++)
  28.         if (uv[i].u_name[0] != 0)
  29.             free(uv[i].u_value);
  30. }
  31.  
  32. char *PASCAL NEAR gtfun(fname)    /* evaluate a function */
  33.  
  34. char *fname;        /* name of function to evaluate */
  35.  
  36. {
  37.     register int fnum;        /* index to function to eval */
  38.     register int arg;        /* value of some arguments */
  39.     char arg1[NSTRING];        /* value of first argument */
  40.     char arg2[NSTRING];        /* value of second argument */
  41.     char arg3[NSTRING];        /* value of third argument */
  42.     static char result[2 * NSTRING];    /* string result */
  43. #if    ENVFUNC
  44.     char *getenv();         /* get environment string */
  45. #endif
  46.  
  47.     /* look the function up in the function table */
  48.     fname[3] = 0;    /* only first 3 chars significant */
  49.     mklower(fname); /* and let it be upper or lower case */
  50.     fnum = binary(fname, funval, NFUNCS);
  51.  
  52.     /* return errorm on a bad reference */
  53.     if (fnum == -1) {
  54.         mlwrite(TEXT244, fname);
  55. /*            "%%No such function as '%s'" */
  56.         return(errorm);
  57.     }
  58.  
  59.     /* if needed, retrieve the first argument */
  60.     if (funcs[fnum].f_type >= MONAMIC) {
  61.         if (macarg(arg1) != TRUE)
  62.             return(errorm);
  63.  
  64.         /* if needed, retrieve the second argument */
  65.         if (funcs[fnum].f_type >= DYNAMIC) {
  66.             if (macarg(arg2) != TRUE)
  67.                 return(errorm);
  68.  
  69.             /* if needed, retrieve the third argument */
  70.             if (funcs[fnum].f_type >= TRINAMIC)
  71.                 if (macarg(arg3) != TRUE)
  72.                     return(errorm);
  73.         }
  74.     }
  75.  
  76.  
  77.     /* and now evaluate it! */
  78.     switch (fnum) {
  79.         case UFABS:    return(int_asc(absv(asc_int(arg1))));
  80.         case UFADD:    return(int_asc(asc_int(arg1) + asc_int(arg2)));
  81.         case UFAND:    return(ltos(stol(arg1) && stol(arg2)));
  82.         case UFASCII:    return(int_asc((int)arg1[0]));
  83.         case UFBAND:    return(int_asc(asc_int(arg1) & asc_int(arg2)));
  84.         case UFBIND:    return(transbind(arg1));
  85.         case UFBNOT:    return(int_asc(~asc_int(arg1)));
  86.         case UFBOR:    return(int_asc(asc_int(arg1) | asc_int(arg2)));
  87.         case UFBXOR:    return(int_asc(asc_int(arg1) ^ asc_int(arg2)));
  88.         case UFCAT:    strcpy(result, arg1);
  89.                 return(strcat(result, arg2));
  90.         case UFCHR:    result[0] = asc_int(arg1);
  91.                 result[1] = 0;
  92.                 return(result);
  93.         case UFDIV:    if ((arg = asc_int(arg2)) != 0)
  94.                     return(int_asc(asc_int(arg1) / arg));
  95.                 else {
  96.                     mlwrite(TEXT245);
  97. /*                        "%%Division by Zero is illegal" */
  98.                     return(errorm);
  99.                 }
  100.         case UFENV:
  101. #if    ENVFUNC
  102.                 return(fixnull(getenv(arg1)));
  103. #else
  104.                 return("");
  105. #endif
  106.         case UFEQUAL:    return(ltos(asc_int(arg1) == asc_int(arg2)));
  107.         case UFEXIST:    return(ltos(fexist(arg1)));
  108.         case UFFIND:
  109.                 return(fixnull(flook(arg1, TRUE)));
  110.         case UFGREATER: return(ltos(asc_int(arg1) > asc_int(arg2)));
  111.         case UFGROUP:
  112.                 if ((arg = asc_int(arg1)) < 0 || arg >= MAXGROUPS)
  113.                     return(bytecopy(result, errorm, NSTRING * 2));
  114.                     
  115. #if    MAGIC
  116.                 return(bytecopy(result, fixnull(grpmatch[arg]),
  117.                      NSTRING * 2));
  118. #else
  119.                 if (arg == 0)
  120.                     bytecopy(result, patmatch, NSTRING * 2);
  121.                 else
  122.                     result[0] = '\0';
  123.                 return(result);
  124. #endif
  125.         case UFGTCMD:    return(cmdstr(getcmd(), result));
  126.         case UFGTKEY:    result[0] = tgetc();
  127.                 result[1] = 0;
  128.                 return(result);
  129.         case UFIND:    return(strcpy(result, fixnull(getval(arg1))));
  130.         case UFISNUM:    return(ltos(is_num(arg1)));
  131.         case UFLEFT:    return(bytecopy(result, arg1, asc_int(arg2)));
  132.         case UFLENGTH:    return(int_asc(strlen(arg1)));
  133.         case UFLESS:    return(ltos(asc_int(arg1) < asc_int(arg2)));
  134.         case UFLOWER:    return(mklower(arg1));
  135.         case UFMID:    arg = asc_int(arg2);
  136.                 if (arg > strlen(arg1))
  137.                     arg = strlen(arg1);
  138.                 return(bytecopy(result, &arg1[arg-1],
  139.                     asc_int(arg3)));
  140.         case UFMOD:    if ((arg = asc_int(arg2)) != 0)
  141.                     return(int_asc(asc_int(arg1) % arg));
  142.                 else {
  143.                     mlwrite(TEXT245);
  144. /*                        "%%Division by Zero is illegal" */
  145.                     return(errorm);
  146.                 }
  147.         case UFNEG:    return(int_asc(-asc_int(arg1)));
  148.         case UFNOT:    return(ltos(stol(arg1) == FALSE));
  149.         case UFOR:    return(ltos(stol(arg1) || stol(arg2)));
  150.         case UFREVERSE: return(strrev(bytecopy(result, arg1, NSTRING * 2)));
  151.         case UFRIGHT:    arg = asc_int(arg2);
  152.                 if (arg > strlen(arg1))
  153.                     arg = strlen(arg1);
  154.                 return(strcpy(result,
  155.                     &arg1[strlen(arg1) - arg]));
  156.         case UFRND:    return(int_asc((int)(ernd() % (long)absv(asc_int(arg1))) + 1L));
  157.         case UFSEQUAL:    return(ltos(strcmp(arg1, arg2) == 0));
  158.         case UFSGREAT:    return(ltos(strcmp(arg1, arg2) > 0));
  159.         case UFSINDEX:    return(int_asc(sindex(arg1, arg2)));
  160.         case UFSLESS:    return(ltos(strcmp(arg1, arg2) < 0));
  161.         case UFSLOWER:    return(setlower(arg1, arg2), "");
  162.         case UFSUB:    return(int_asc(asc_int(arg1) - asc_int(arg2)));
  163.         case UFSUPPER:    return(setupper(arg1, arg2), "");
  164.         case UFTIMES:    return(int_asc(asc_int(arg1) * asc_int(arg2)));
  165.         case UFTRIM:    return(trimstr(arg1));
  166.         case UFTRUTH:    return(ltos(asc_int(arg1) == 42));
  167.         case UFUPPER:    return(mkupper(arg1));
  168.         case UFXLATE:    return(xlat(arg1, arg2, arg3));
  169.     }
  170.  
  171.     meexit(-11);    /* never should get here */
  172. }
  173.  
  174. char *PASCAL NEAR gtusr(vname)    /* look up a user var's value */
  175.  
  176. char *vname;        /* name of user variable to fetch */
  177.  
  178. {
  179.     register int vnum;    /* ordinal number of user var */
  180.     register char *vptr;    /* temp pointer to function value */
  181.  
  182.     /* limit comparisons to significant length */
  183.     if (strlen(vname) >= NVSIZE)    /* "%" counts, but is not passed */
  184.         vname[NVSIZE-1] = '\0';
  185.  
  186.     /* scan the list looking for the user var name */
  187.     for (vnum = 0; vnum < MAXVARS; vnum++) {
  188.         if (uv[vnum].u_name[0] == 0)
  189.             return(errorm);
  190.         if (strcmp(vname, uv[vnum].u_name) == 0) {
  191.             vptr = uv[vnum].u_value;
  192.             if (vptr)
  193.                 return(vptr);
  194.             else
  195.                 return(errorm);
  196.         }
  197.     }
  198.  
  199.     /* return errorm if we run off the end */
  200.     return(errorm);
  201. }
  202.  
  203. char *PASCAL NEAR funval(i)
  204.  
  205. int i;
  206.  
  207. {
  208.     return(funcs[i].f_name);
  209. }
  210.  
  211. char *PASCAL NEAR envval(i)
  212.  
  213. int i;
  214.  
  215. {
  216.     return(envars[i]);
  217. }
  218.  
  219. PASCAL NEAR binary(key, tval, tlength)
  220.  
  221. char *key;        /* key string to look for */
  222. char *(PASCAL NEAR *tval)();    /* ptr to function to fetch table value with */
  223. int tlength;        /* length of table to search */
  224.  
  225. {
  226.     int l, u;    /* lower and upper limits of binary search */
  227.     int i;        /* current search index */
  228.     int cresult;    /* result of comparison */
  229.  
  230.     /* set current search limit as entire list */
  231.     l = 0;
  232.     u = tlength - 1;
  233.  
  234.     /* get the midpoint! */
  235.     while (u >= l) {
  236.         i = (l + u) >> 1;
  237.  
  238.         /* do the comparison */
  239.         cresult = strcmp(key, (*tval)(i));
  240.         if (cresult == 0)
  241.             return(i);
  242.         if (cresult < 0)
  243.             u = i - 1;
  244.         else
  245.             l = i + 1;
  246.     }
  247.     return(-1);
  248. }
  249.  
  250. char *PASCAL NEAR gtenv(vname)
  251.  
  252. char *vname;        /* name of environment variable to retrieve */
  253.  
  254. {
  255.     register int vnum;    /* ordinal number of var refrenced */
  256.     static char result[2 * NSTRING];    /* string result */
  257.  
  258.     /* scan the list, looking for the referenced name */
  259.     vnum = binary(vname, envval, NEVARS);
  260.  
  261.     /* return errorm on a bad reference */
  262.     if (vnum == -1)
  263.         return(errorm);
  264.  
  265.     /* otherwise, fetch the appropriate value */
  266.     switch (vnum) {
  267.         case EVACOUNT:    return(int_asc(gacount));
  268.         case EVASAVE:    return(int_asc(gasave));
  269.         case EVBUFHOOK: return(fixnull(getfname(&bufhook)));
  270.         case EVCBFLAGS: return(int_asc(curbp->b_flag));
  271.         case EVCBUFNAME:return(curbp->b_bname);
  272.         case EVCFNAME:    return(curbp->b_fname);
  273.         case EVCMDHK:    return(fixnull(getfname(&cmdhook)));
  274.         case EVCMODE:    return(int_asc(curbp->b_mode));
  275.         case EVCURCHAR:
  276.             return(lused(curwp->w_dotp) ==
  277.                     curwp->w_doto ? int_asc('\r') :
  278.                 int_asc(lgetc(curwp->w_dotp, curwp->w_doto)));
  279.         case EVCURCOL:    return(int_asc(getccol(FALSE)));
  280.         case EVCURLINE: return(long_asc(getlinenum(curbp, curwp->w_dotp)));
  281.         case EVCURWIDTH:return(int_asc(term.t_ncol));
  282.         case EVCURWIND: return(int_asc(getcwnum()));
  283.         case EVCWLINE:    return(int_asc(getwpos()));
  284.         case EVDEBUG:    return(ltos(macbug));
  285.         case EVDESKCLR: return(cname[deskcolor]);
  286.         case EVDIAGFLAG:return(ltos(diagflag));
  287.         case EVDISCMD:    return(ltos(discmd));
  288.         case EVDISINP:    return(ltos(disinp));
  289.         case EVDISPHIGH:return(ltos(disphigh));
  290.         case EVEXBHOOK: return(fixnull(getfname(&exbhook)));
  291.         case EVFCOL:    return(int_asc(curwp->w_fcol));
  292.         case EVFILLCOL: return(int_asc(fillcol));
  293.         case EVFLICKER: return(ltos(flickcode));
  294.         case EVFMTLEAD: return(fmtlead);
  295.         case EVGFLAGS:    return(int_asc(gflags));
  296.         case EVGMODE:    return(int_asc(gmode));
  297.         case EVHARDTAB: return(int_asc(tabsize));
  298.         case EVHILITE:    return(int_asc(hilite));
  299.         case EVHJUMP:    return(int_asc(hjump));
  300.         case EVHSCRLBAR: return(ltos(hscrollbar));
  301.         case EVHSCROLL: return(ltos(hscroll));
  302.         case EVISTERM:    return(cmdstr(isterm, result));
  303.         case EVKILL:    return(getkill());
  304.         case EVLANG:    return(LANGUAGE);
  305.         case EVLASTKEY: return(int_asc(lastkey));
  306.         case EVLASTMESG:return(lastmesg);
  307.         case EVLINE:    return(getctext());
  308.         case EVLTERM:    return(lterm);
  309.         case EVLWIDTH:    return(int_asc(lused(curwp->w_dotp)));
  310.         case EVMATCH:    return(fixnull(patmatch));
  311.         case EVMMOVE:    return(int_asc(mouse_move));
  312.         case EVMODEFLAG:return(ltos(modeflag));
  313.         case EVMSFLAG:    return(ltos(mouseflag));
  314.         case EVNUMWIND: return(int_asc(gettwnum()));
  315.         case EVORGCOL:    return(int_asc(term.t_colorg));
  316.         case EVORGROW:    return(int_asc(term.t_roworg));
  317.         case EVOS:    return(os);
  318.         case EVOVERLAP: return(int_asc(overlap));
  319.         case EVPAGELEN: return(int_asc(term.t_nrow + 1));
  320.         case EVPALETTE: return(palstr);
  321.         case EVPARALEAD:return(paralead);
  322.         case EVPENDING:
  323. #if    TYPEAH || WINDOW_MSWIN
  324.                 return(ltos(typahead()));
  325. #else
  326.                 return(falsem);
  327. #endif
  328.         case EVPOPFLAG: return(ltos(popflag));
  329.         case EVPOSFLAG: return(ltos(posflag));
  330.         case EVPROGNAME:return(PROGNAME);
  331.         case EVRAM:    return(int_asc((int)(envram / 1024l)));
  332.         case EVREADHK:    return(fixnull(getfname(&readhook)));
  333.         case EVREGION:    return(getreg(result));
  334.         case EVREPLACE: return((char *)rpat);
  335.         case EVRVAL:    return(int_asc(rval));
  336.         case EVSCRNAME: return(first_screen->s_screen_name);
  337.         case EVSEARCH:    return((char *)pat);
  338.         case EVSEARCHPNT:    return(int_asc(searchtype));
  339.         case EVSEED:    return(int_asc((int)seed));
  340.         case EVSOFTTAB: return(int_asc(stabsize));
  341.         case EVSRES:    return(sres);
  342.         case EVSSAVE:    return(ltos(ssave));
  343.         case EVSSCROLL: return(ltos(sscroll));
  344.         case EVSTATUS:    return(ltos(cmdstatus));
  345.         case EVSTERM:    return(cmdstr(sterm, result));
  346.         case EVTARGET:    saveflag = lastflag;
  347.                 return(int_asc(curgoal));
  348.         case EVTIME:    return(timeset());
  349.         case EVTIMEFLAG: return(ltos(timeflag));
  350.         case EVTPAUSE:    return(int_asc(term.t_pause));
  351.         case EVVERSION: return(VERSION);
  352.         case EVVSCRLBAR: return(ltos(vscrollbar));
  353.         case EVWCHARS:    return(getwlist(result));
  354.         case EVWLINE:    return(int_asc(curwp->w_ntrows));
  355.         case EVWRAPHK:    return(fixnull(getfname(&wraphook)));
  356.         case EVWRITEHK: return(fixnull(getfname(&writehook)));
  357.         case EVXPOS:    return(int_asc(xpos));
  358.         case EVYANKFLAG: return(ltos(yankflag));
  359.         case EVYPOS:    return(int_asc(ypos));
  360.     }
  361.     meexit(-12);    /* again, we should never get here */
  362. }
  363.  
  364. char *PASCAL NEAR fixnull(s)    /* Don't return NULL pointers! */
  365.  
  366. char *s;
  367.  
  368. {
  369.     if (s == NULL)
  370.         return("");
  371.     else
  372.         return(s);
  373. }
  374.  
  375. /* return some of the contents of the kill buffer */
  376.  
  377. char *PASCAL NEAR getkill()
  378.  
  379. {
  380.     register int size;    /* max number of chars left to return */
  381.     register char *sp;    /* ptr into KILL block data chunk */
  382.     register char *vp;    /* ptr into return value */
  383.     KILL *kptr;        /* ptr to the current KILL block */
  384.     int counter;        /* index into data chunk */
  385.     static char value[NSTRING];    /* temp buffer for value */
  386.  
  387.     /* no kill buffer....just a null string */
  388.     if (kbufh[kill_index] == (KILL *)NULL) {
  389.         value[0] = 0;
  390.         return(value);
  391.     }
  392.  
  393.     /* set up the output buffer */
  394.     vp = value;
  395.     size = NSTRING - 1;
  396.  
  397.     /* backed up characters? */
  398.     if (kskip[kill_index] > 0) {
  399.         kptr = kbufh[kill_index];
  400.         sp = &(kptr->d_chunk[kskip[kill_index]]);
  401.         counter = kskip[kill_index];
  402.         while (counter++ < KBLOCK) {
  403.             *vp++ = *sp++;
  404.             if (--size == 0) {
  405.                 *vp = 0;
  406.                 return(value);
  407.             }
  408.         }
  409.         kptr = kptr->d_next;
  410.     } else {
  411.         kptr = kbufh[kill_index];
  412.     }
  413.  
  414.     if (kptr != (KILL *)NULL) {
  415.         while (kptr != kbufp[kill_index]) {
  416.             sp = kptr->d_chunk;
  417.             for (counter = 0; counter < KBLOCK; counter++) {
  418.                 *vp++ = *sp++;
  419.                 if (--size == 0) {
  420.                     *vp = 0;
  421.                     return(value);
  422.                 }
  423.             }
  424.             kptr = kptr->d_next;
  425.         }
  426.         counter = kused[kill_index];
  427.         sp = kptr->d_chunk;
  428.         while (counter--) {
  429.             *vp++ = *sp++;
  430.             if (--size == 0) {
  431.                 *vp = 0;
  432.                 return(value);
  433.             }
  434.         }
  435.     }
  436.         
  437.     /* and return the constructed value */
  438.     *vp = 0;
  439.     return(value);
  440. }
  441.  
  442. char *PASCAL NEAR trimstr(s)    /* trim whitespace off the end of a string */
  443.  
  444. char *s;    /* string to trim */
  445.  
  446. {
  447.     char *sp;    /* backward index */
  448.  
  449.     sp = s + strlen(s) - 1;
  450.     while ((sp >= s) && (*sp == ' ' || *sp == '\t'))
  451.         --sp;
  452.     *(sp+1) = 0;
  453.     return(s);
  454. }
  455.  
  456. int PASCAL NEAR setvar(f, n)        /* set a variable */
  457.  
  458. int f;        /* default flag */
  459. int n;        /* numeric arg (can overide prompted value) */
  460.  
  461. {
  462.     register int status;    /* status return */
  463.     VDESC vd;        /* variable num/type */
  464.     char var[NVSIZE+1];    /* name of variable to fetch */
  465.     char value[NSTRING];    /* value to set variable to */
  466.  
  467.     /* first get the variable to set.. */
  468.     if (clexec == FALSE) {
  469.         status = mlreply(TEXT51, &var[0], NVSIZE+1);
  470. /*                 "Variable to set: " */
  471.         if (status != TRUE)
  472.             return(status);
  473.     } else {    /* macro line argument */
  474.         /* grab token and skip it */
  475.         execstr = token(execstr, var, NVSIZE + 1);
  476.     }
  477.  
  478.     /* check the legality and find the var */
  479.     findvar(var, &vd, NVSIZE + 1);
  480.         
  481.     /* if its not legal....bitch */
  482.     if (vd.v_type == -1) {
  483.         mlwrite(TEXT52, var);
  484. /*            "%%No such variable as '%s'" */
  485.         return(FALSE);
  486.     }
  487.  
  488.     /* get the value for that variable */
  489.     if (f == TRUE)
  490.         strcpy(value, int_asc(n));
  491.     else {
  492.         status = mlreply(TEXT53, &value[0], NSTRING);
  493. /*                 "Value: " */
  494.         if (status == ABORT)
  495.             return(status);
  496.     }
  497.  
  498.     /* and set the appropriate value */
  499.     status = svar(&vd, value);
  500.  
  501. #if    DEBUGM
  502.     /* if $debug == TRUE, every assignment will echo a statment to
  503.        that effect here. */
  504.         
  505.     if (macbug && (strcmp(var, "%track") != 0)) {
  506.         strcpy(outline, "(((");
  507.  
  508.         strcat(outline, var);
  509.         strcat(outline, " <- ");
  510.  
  511.         /* and lastly the value we tried to assign */
  512.         strcat(outline, value);
  513.         strcat(outline, ")))");
  514.  
  515.         /* expand '%' to "%%" so mlwrite wont bitch */
  516.         makelit(outline);
  517.  
  518.         /* write out the debug line */
  519.         mlforce(outline);
  520.         update(TRUE);
  521.  
  522.         /* and get the keystroke to hold the output */
  523.         if (getkey() == abortc) {
  524.             mlforce(TEXT54);
  525. /*                "[Macro aborted]" */
  526.             status = FALSE;
  527.         }
  528.     }
  529. #endif
  530.  
  531.     /* and return it */
  532.     return(status);
  533. }
  534.  
  535. PASCAL NEAR findvar(var, vd, size)    /* find a variables type and name */
  536.  
  537. char *var;    /* name of var to get */
  538. VDESC *vd;    /* structure to hold type and ptr */
  539. int size;    /* size of var array */
  540.  
  541. {
  542.     register int vnum;    /* subscript in varable arrays */
  543.     register int vtype;    /* type to return */
  544.  
  545. fvar:    vtype = -1;
  546.     switch (var[0]) {
  547.  
  548.         case '$': /* check for legal enviromnent var */
  549.             if ((vnum = binary(&var[1], envval, NEVARS)) != -1)
  550.                 vtype = TKENV;
  551.             break;
  552.  
  553.         case '%': /* check for existing legal user variable */
  554.             for (vnum = 0; vnum < MAXVARS; vnum++)
  555.                 if (strcmp(&var[1], uv[vnum].u_name) == 0) {
  556.                     vtype = TKVAR;
  557.                     break;
  558.                 }
  559.             if (vnum < MAXVARS)
  560.                 break;
  561.  
  562.             /* create a new one??? */
  563.             for (vnum = 0; vnum < MAXVARS; vnum++)
  564.                 if (uv[vnum].u_name[0] == 0) {
  565.                     vtype = TKVAR;
  566.                     strcpy(uv[vnum].u_name, &var[1]);
  567.                     uv[vnum].u_value = NULL;
  568.                     break;
  569.                 }
  570.             break;
  571.  
  572.         case '&':    /* indirect operator? */
  573.             var[4] = 0;
  574.             if (strcmp(&var[1], "ind") == 0) {
  575.                 /* grab token, and eval it */
  576.                 execstr = token(execstr, var, size);
  577.                 strcpy(var, fixnull(getval(var)));
  578.                 goto fvar;
  579.             }
  580.     }
  581.  
  582.     /* return the results */
  583.     vd->v_num = vnum;
  584.     vd->v_type = vtype;
  585.     return;
  586. }
  587.  
  588. int PASCAL NEAR svar(var, value)    /* set a variable */
  589.  
  590. VDESC *var;    /* variable to set */
  591. char *value;    /* value to set to */
  592.  
  593. {
  594.     register int vnum;    /* ordinal number of var refrenced */
  595.     register int vtype;    /* type of variable to set */
  596.     register int status;    /* status return */
  597.     register int c;     /* translated character */
  598.     register char *sp;    /* scratch string pointer */
  599.  
  600.     /* simplify the vd structure (we are gonna look at it a lot) */
  601.     vnum = var->v_num;
  602.     vtype = var->v_type;
  603.  
  604.     /* and set the appropriate value */
  605.     status = TRUE;
  606.     switch (vtype) {
  607.     case TKVAR: /* set a user variable */
  608.         if (uv[vnum].u_value != NULL)
  609.             free(uv[vnum].u_value);
  610.         sp = malloc(strlen(value) + 1);
  611.         if (sp == NULL)
  612.             return(FALSE);
  613.         strcpy(sp, value);
  614.         uv[vnum].u_value = sp;
  615. #if    1
  616.         if (strcmp(value, errorm) == 0)
  617.             status = FALSE;
  618. #endif
  619.         break;
  620.  
  621.     case TKENV: /* set an environment variable */
  622.         status = TRUE;    /* by default */
  623.  
  624.         switch (vnum) {
  625.         case EVACOUNT:    gacount = asc_int(value);
  626.                 break;
  627.         case EVASAVE:    gasave = asc_int(value);
  628.                 break;
  629.         case EVBUFHOOK: setkey(&bufhook, value);
  630.                 break;
  631.         case EVCBFLAGS: curbp->b_flag = (curbp->b_flag & ~(BFCHG|BFINVS))
  632.                     | (asc_int(value) & (BFCHG|BFINVS));
  633.                 lchange(WFMODE);
  634.                 break;
  635.         case EVCBUFNAME:strcpy(curbp->b_bname, value);
  636.                 curwp->w_flag |= WFMODE;
  637.                 break;
  638.         case EVCFNAME:    strcpy(curbp->b_fname, value);
  639. #if    WINDOW_MSWIN
  640.                         fullpathname (curbp->b_fname, NFILEN);
  641. #endif
  642.                 curwp->w_flag |= WFMODE;
  643.                 break;
  644.         case EVCMDHK:    setkey(&cmdhook, value);
  645.                 break;
  646.         case EVCMODE:    curbp->b_mode = asc_int(value);
  647.                 curwp->w_flag |= WFMODE;
  648.                 break;
  649.         case EVCURCHAR: ldelete(1L, FALSE);    /* delete 1 char */
  650.                 c = asc_int(value);
  651.                 if (c == '\r')
  652.                     lnewline();
  653.                 else
  654.                     linsert(1, (char)c);
  655.                 backchar(FALSE, 1);
  656.                 break;
  657.         case EVCURCOL:    status = setccol(asc_int(value));
  658.                 break;
  659.         case EVCURLINE: status = gotoline(TRUE, asc_int(value));
  660.                 break;
  661.         case EVCURWIDTH:status = newwidth(TRUE, asc_int(value));
  662.                 break;
  663.         case EVCURWIND: nextwind(TRUE, asc_int(value));
  664.                 break;
  665.         case EVCWLINE:    status = forwline(TRUE,
  666.                         asc_int(value) - getwpos());
  667.                 break;
  668.         case EVDEBUG:    macbug = stol(value);
  669.                 break;
  670.         case EVDESKCLR: c = lookup_color(mkupper(value));
  671.                 if (c != -1) {
  672.                     deskcolor = c;
  673. #if    WINDOW_TEXT
  674.                     refresh_screen(first_screen);
  675. #endif
  676.                 }
  677.                 break;
  678.         case EVDIAGFLAG:diagflag = stol(value);
  679.                 break;
  680.         case EVDISCMD:    discmd = stol(value);
  681.                 break;
  682.         case EVDISINP:    disinp = stol(value);
  683.                 break;
  684.         case EVDISPHIGH:
  685.                 c = disphigh;
  686.                 disphigh = stol(value);
  687.                 if (c != disphigh)
  688.                     upwind();
  689.                 break;
  690.         case EVEXBHOOK: setkey(&exbhook, value);
  691.                 break;
  692.         case EVFCOL:    curwp->w_fcol = asc_int(value);
  693.                 if (curwp->w_fcol < 0)
  694.                     curwp->w_fcol = 0;
  695.                 curwp->w_flag |= WFHARD | WFMODE;
  696.                 break;
  697.         case EVFILLCOL: fillcol = asc_int(value);
  698.                 break;
  699.         case EVFLICKER: flickcode = stol(value);
  700.                 break;
  701.         case EVFMTLEAD: bytecopy(fmtlead, value, NSTRING);
  702.                 break;
  703.         case EVGFLAGS:    gflags = asc_int(value);
  704.                 break;
  705.         case EVGMODE:    gmode = asc_int(value);
  706.                 break;
  707.         case EVHARDTAB: tabsize = asc_int(value);
  708.                 upwind();
  709.                 break;
  710.         case EVHILITE:    hilite = asc_int(value);
  711.                 if (hilite > NMARKS)
  712.                     hilite = 255;
  713.                 break;
  714.         case EVHJUMP:    hjump = asc_int(value);
  715.                 if (hjump < 1)
  716.                     hjump = 1;
  717.                 if (hjump > term.t_ncol - 1)
  718.                     hjump = term.t_ncol - 1;
  719.                 break;
  720.         case EVHSCRLBAR: hscrollbar = stol(value);
  721.                 break;
  722.         case EVHSCROLL: hscroll = stol(value);
  723.                 lbound = 0;
  724.                 break;
  725.         case EVISTERM:    isterm = stock(value);
  726.                 break;
  727.         case EVKILL:    break;
  728.         case EVLANG:    break;
  729.         case EVLASTKEY: lastkey = asc_int(value);
  730.                 break;
  731.         case EVLASTMESG:strcpy(lastmesg, value);
  732.                 break;
  733.         case EVLINE:    putctext(value);
  734.                 break;
  735.         case EVLTERM:    bytecopy(lterm, value, NSTRING);
  736.                 break;
  737.         case EVLWIDTH:    break;
  738.         case EVMATCH:    break;
  739.         case EVMMOVE:    mouse_move = asc_int(value);
  740.                 if (mouse_move < 0) mouse_move = 0;
  741.                 if (mouse_move > 2) mouse_move = 2;
  742.                 break;
  743.         case EVMODEFLAG:modeflag = stol(value);
  744.                 upwind();
  745.                 break;
  746.         case EVMSFLAG:    mouseflag = stol(value);
  747.                 break;
  748.         case EVNUMWIND: break;
  749.         case EVORGCOL:    status = new_col_org(TRUE, asc_int(value));
  750.                 break;
  751.         case EVORGROW:    status = new_row_org(TRUE, asc_int(value));
  752.                 break;
  753.         case EVOS:    break;
  754.         case EVOVERLAP: overlap = asc_int(value);
  755.                 break;
  756.         case EVPAGELEN: status = newsize(TRUE, asc_int(value));
  757.                 break;
  758.         case EVPALETTE: bytecopy(palstr, value, 48);
  759.                 spal(palstr);
  760.                 break;
  761.         case EVPARALEAD:bytecopy(paralead, value, NSTRING);
  762.                 break;
  763.         case EVPENDING: break;
  764.         case EVPOPFLAG: popflag = stol(value);
  765.                 break;
  766.         case EVPOSFLAG: posflag = stol(value);
  767.                 upmode();
  768.                 break;
  769.         case EVPROGNAME:break;
  770.         case EVRAM:    break;
  771.         case EVREADHK:    setkey(&readhook, value);
  772.                 break;
  773.         case EVREGION:    break;
  774.         case EVREPLACE: strcpy(rpat, value);
  775. #if    MAGIC
  776.                 rmcclear();
  777. #endif 
  778.                 break;
  779.         case EVRVAL:    break;
  780.         case EVSCRNAME: select_screen(lookup_screen(value), TRUE);
  781.                 break;
  782.         case EVSEARCH:    strcpy(pat, value);
  783.                 setjtable(); /* Set up fast search arrays  */
  784. #if    MAGIC
  785.                 mcclear();
  786. #endif
  787.                 break;
  788.         case EVSEARCHPNT:    searchtype = asc_int(value);
  789.                 if (searchtype < SRNORM  || searchtype > SREND)
  790.                     searchtype = SRNORM;
  791.                 break;
  792.         case EVSEED:    seed = (long)abs(asc_int(value));
  793.                 break;
  794.         case EVSOFTTAB: stabsize = asc_int(value);
  795.                 upwind();
  796.                 break;
  797.         case EVSRES:    status = TTrez(value);
  798.                 break;
  799.         case EVSSAVE:    ssave = stol(value);
  800.                 break;
  801.         case EVSSCROLL: sscroll = stol(value);
  802.                 break;
  803.         case EVSTATUS:    cmdstatus = stol(value);
  804.                 break;
  805.         case EVSTERM:    sterm = stock(value);
  806.                 break;
  807.         case EVTARGET:    curgoal = asc_int(value);
  808.                 thisflag = saveflag;
  809.                 break;
  810.         case EVTIME:    break;
  811.         case EVTIMEFLAG: timeflag = stol(value);
  812.                 upmode();
  813.                 break;
  814.         case EVTPAUSE:    term.t_pause = asc_int(value);
  815.                 break;
  816.         case EVVERSION: break;
  817.         case EVVSCRLBAR: vscrollbar = stol(value);
  818.                 break;
  819.         case EVWCHARS:    setwlist(value);
  820.                 break;
  821.         case EVWLINE:    status = resize(TRUE, asc_int(value));
  822.                 break;
  823.         case EVWRAPHK:    setkey(&wraphook, value);
  824.                 break;
  825.         case EVWRITEHK: setkey(&writehook, value);
  826.                 break;
  827.         case EVXPOS:    xpos = asc_int(value);
  828.                 break;
  829.         case EVYANKFLAG:    yankflag = stol(value);
  830.                 break;
  831.         case EVYPOS:    ypos = asc_int(value);
  832.                 break;
  833.         }
  834.         break;
  835.     }
  836.     return(status);
  837. }
  838.  
  839. /*    asc_int:    ascii string to integer......This is too
  840.         inconsistant to use the system's    */
  841.  
  842. int PASCAL NEAR asc_int(st)
  843.  
  844. char *st;
  845.  
  846. {
  847.     int result;    /* resulting number */
  848.     int sign;    /* sign of resulting number */
  849.     char c;     /* current char being examined */
  850.  
  851.     result = 0;
  852.     sign = 1;
  853.  
  854.     /* skip preceding whitespace */
  855.     while (*st == ' ' || *st == '\t')
  856.         ++st;
  857.  
  858.     /* check for sign */
  859.     if (*st == '-') {
  860.         sign = -1;
  861.         ++st;
  862.     }
  863.     if (*st == '+')
  864.         ++st;
  865.  
  866.     /* scan digits, build value */
  867.     while ((c = *st++))
  868.         if (c >= '0' && c <= '9')
  869.             result = result * 10 + c - '0';
  870.         else
  871.             break;
  872.  
  873.     return(result * sign);
  874. }
  875.  
  876. /*    int_asc:    integer to ascii string.......... This is too
  877.             inconsistant to use the system's    */
  878.  
  879. char *PASCAL NEAR int_asc(i)
  880.  
  881. int i;    /* integer to translate to a string */
  882.  
  883. {
  884.     register int digit;        /* current digit being used */
  885.     register char *sp;        /* pointer into result */
  886.     register int sign;        /* sign of resulting number */
  887.     static char result[INTWIDTH+1]; /* resulting string */
  888.  
  889.     /* this is a special case */
  890.     if (i == -32768) {
  891.         strcpy(result, "-32768");
  892.         return(result);
  893.     }
  894.  
  895.     /* record the sign...*/
  896.     sign = 1;
  897.     if (i < 0) {
  898.         sign = -1;
  899.         i = -i;
  900.     }
  901.  
  902.     /* and build the string (backwards!) */
  903.     sp = result + INTWIDTH;
  904.     *sp = 0;
  905.     do {
  906.         digit = i % 10;
  907.         *(--sp) = '0' + digit;    /* and install the new digit */
  908.         i = i / 10;
  909.     } while (i);
  910.  
  911.     /* and fix the sign */
  912.     if (sign == -1) {
  913.         *(--sp) = '-';    /* and install the minus sign */
  914.     }
  915.  
  916.     return(sp);
  917. }
  918.  
  919. /*    long_asc:    long to ascii string.......... This is too
  920.             inconsistant to use the system's    */
  921.  
  922. char *PASCAL NEAR long_asc(num)
  923.  
  924. long num;    /* integer to translate to a string */
  925.  
  926. {
  927.     register int digit;        /* current digit being used */
  928.     register char *sp;        /* pointer into result */
  929.     register int sign;        /* sign of resulting number */
  930.     static char result[LONGWIDTH+1]; /* resulting string */
  931.  
  932.     /* record the sign...*/
  933.     sign = 1;
  934.     if (num < 0L) {
  935.         sign = -1;
  936.         num = -num;
  937.     }
  938.  
  939.     /* and build the string (backwards!) */
  940.     sp = result + LONGWIDTH;
  941.     *sp = 0;
  942.     do {
  943.         digit = num % 10;
  944.         *(--sp) = '0' + digit;    /* and install the new digit */
  945.         num = num / 10L;
  946.     } while (num);
  947.  
  948.     /* and fix the sign */
  949.     if (sign == -1) {
  950.         *(--sp) = '-';    /* and install the minus sign */
  951.     }
  952.  
  953.     return(sp);
  954. }
  955.  
  956. int PASCAL NEAR gettyp(token)    /* find the type of a passed token */
  957.  
  958. char *token;    /* token to analyze */
  959.  
  960. {
  961.     register char c;    /* first char in token */
  962.  
  963.     /* grab the first char (this is all we need) */
  964.     c = *token;
  965.  
  966.     /* no blanks!!! */
  967.     if (c == 0)
  968.         return(TKNUL);
  969.  
  970.     /* a numeric literal? */
  971.     if (c >= '0' && c <= '9')
  972.         return(TKLIT);
  973.  
  974.     switch (c) {
  975.         case '"':    return(TKSTR);
  976.  
  977.         case '!':    return(TKDIR);
  978.         case '@':    return(TKARG);
  979.         case '#':    return(TKBUF);
  980.         case '$':    return(TKENV);
  981.         case '%':    return(TKVAR);
  982.         case '&':    return(TKFUN);
  983.         case '*':    return(TKLBL);
  984.  
  985.         default:    return(TKCMD);
  986.     }
  987. }
  988.  
  989. char *PASCAL NEAR getval(token) /* find the value of a token */
  990.  
  991. char *token;        /* token to evaluate */
  992.  
  993. {
  994.     register int status;    /* error return */
  995.     register BUFFER *bp;    /* temp buffer pointer */
  996.     register int blen;    /* length of buffer argument */
  997.     static char buf[NSTRING];/* string buffer for some returns */
  998.  
  999.     switch (gettyp(token)) {
  1000.         case TKNUL:    return("");
  1001.  
  1002.         case TKARG:    /* interactive argument */
  1003.                 strcpy(token, fixnull(getval(&token[1])));
  1004.                 mlwrite("%s", token);
  1005.                 status = getstring(buf, NSTRING, ctoec(RETCHAR));
  1006.                 if (status == ABORT)
  1007.                     return(NULL);
  1008.                 return(buf);
  1009.  
  1010.         case TKBUF:    /* buffer contents fetch */
  1011.  
  1012.                 /* grab the right buffer */
  1013.                 strcpy(token, fixnull(getval(&token[1])));
  1014.                 bp = bfind(token, FALSE, 0);
  1015.                 if (bp == NULL)
  1016.                     return(NULL);
  1017.             
  1018.                 /* if the buffer is displayed, get the window
  1019.                    vars instead of the buffer vars */
  1020.                 if (bp->b_nwnd > 0) {
  1021.                     curbp->b_dotp = curwp->w_dotp;
  1022.                     curbp->b_doto = curwp->w_doto;
  1023.                 }
  1024.  
  1025.                 /* if we are at the end, return <END> */
  1026.                 if (bp->b_linep == bp->b_dotp)
  1027.                     return("<END>");
  1028.             
  1029.                 /* grab the line as an argument */
  1030.                 blen = lused(bp->b_dotp) - bp->b_doto;
  1031.                 if (blen > NSTRING)
  1032.                     blen = NSTRING;
  1033.                 bytecopy(buf, ltext(bp->b_dotp) + bp->b_doto,
  1034.                     blen);
  1035.                 buf[blen] = 0;
  1036.             
  1037.                 /* and step the buffer's line ptr ahead a line */
  1038.                 bp->b_dotp = lforw(bp->b_dotp);
  1039.                 bp->b_doto = 0;
  1040.  
  1041.                 /* if displayed buffer, reset window ptr vars*/
  1042.                 if (bp->b_nwnd > 0) {
  1043.                     curwp->w_dotp = curbp->b_dotp;
  1044.                     curwp->w_doto = 0;
  1045.                     curwp->w_flag |= WFMOVE;
  1046.                 }
  1047.  
  1048.                 /* and return the spoils */
  1049.                 return(buf);            
  1050.  
  1051.         case TKVAR:    return(gtusr(token+1));
  1052.         case TKENV:    return(gtenv(token+1));
  1053.         case TKFUN:    return(gtfun(token+1));
  1054.         case TKDIR:    return(NULL);
  1055.         case TKLBL:    return(NULL);
  1056.         case TKLIT:    return(token);
  1057.         case TKSTR:    return(token+1);
  1058.         case TKCMD:    return(token);
  1059.     }
  1060. }
  1061.  
  1062. int PASCAL NEAR stol(val)    /* convert a string to a numeric logical */
  1063.  
  1064. char *val;    /* value to check for stol */
  1065.  
  1066. {
  1067.     /* check for logical values */
  1068.     if (val[0] == 'F')
  1069.         return(FALSE);
  1070.     if (val[0] == 'T')
  1071.         return(TRUE);
  1072.  
  1073.     /* check for numeric truth (!= 0) */
  1074.     return((asc_int(val) != 0));
  1075. }
  1076.  
  1077. char *PASCAL NEAR ltos(val)    /* numeric logical to string logical */
  1078.  
  1079. int val;    /* value to translate */
  1080.  
  1081. {
  1082.     if (val)
  1083.         return(truem);
  1084.     else
  1085.         return(falsem);
  1086. }
  1087.  
  1088. char *PASCAL NEAR mkupper(str)    /* make a string upper case */
  1089.  
  1090. char *str;        /* string to upper case */
  1091.  
  1092. {
  1093.     char *sp;
  1094.  
  1095.     sp = str;
  1096.     while (*sp)
  1097.         uppercase((unsigned char *)sp++);
  1098.     return(str);
  1099. }
  1100.  
  1101. char *PASCAL NEAR mklower(str)    /* make a string lower case */
  1102.  
  1103. char *str;        /* string to lower case */
  1104.  
  1105. {
  1106.     char *sp;
  1107.  
  1108.     sp = str;
  1109.     while (*sp)
  1110.         lowercase((unsigned char *)sp++);
  1111.     return(str);
  1112. }
  1113.  
  1114. int PASCAL NEAR absv(x) /* take the absolute value of an integer */
  1115.  
  1116. int x;
  1117.  
  1118. {
  1119.     return(x < 0 ? -x : x);
  1120. }
  1121.  
  1122. long PASCAL NEAR ernd()    /* returns a random integer */
  1123.  
  1124. /* This function implements the "minimal standard" RNG
  1125.    from the paper "RNGs: Good Ones are Hard to Find" by Park and
  1126.    Miller, CACM, Volume 31, Number 10, October 1988. */
  1127.  
  1128. {
  1129.     long int a=16807L, m=2147483647L, q=127773L, r=2836L;
  1130.     long lo, hi, test;
  1131.  
  1132.     hi = seed / q;
  1133.     lo = seed % q;
  1134.     test = a * lo - r * hi;
  1135.     seed = (test > 0) ? test : test + m;
  1136.     return(seed);
  1137. }
  1138.  
  1139. int PASCAL NEAR sindex(source, pattern) /* find pattern within source */
  1140.  
  1141. char *source;    /* source string to search */
  1142. char *pattern;    /* string to look for */
  1143.  
  1144. {
  1145.     char *sp;    /* ptr to current position to scan */
  1146.     char *csp;    /* ptr to source string during comparison */
  1147.     char *cp;    /* ptr to place to check for equality */
  1148.  
  1149.     /* scanning through the source string */
  1150.     sp = source;
  1151.     while (*sp) {
  1152.         /* scan through the pattern */
  1153.         cp = pattern;
  1154.         csp = sp;
  1155.         while (*cp) {
  1156.             if (!eq(*cp, *csp))
  1157.                 break;
  1158.             ++cp;
  1159.             ++csp;
  1160.         }
  1161.  
  1162.         /* was it a match? */
  1163.         if (*cp == 0)
  1164.             return((int)(sp - source) + 1);
  1165.         ++sp;
  1166.     }
  1167.  
  1168.     /* no match at all.. */
  1169.     return(0);
  1170. }
  1171.  
  1172. /*    Filter a string through a translation table    */
  1173.  
  1174. char *PASCAL NEAR xlat(source, lookup, trans)
  1175.  
  1176. char *source;    /* string to filter */
  1177. char *lookup;    /* characters to translate */
  1178. char *trans;    /* resulting translated characters */
  1179.  
  1180. {
  1181.     register char *sp;    /* pointer into source table */
  1182.     register char *lp;    /* pointer into lookup table */
  1183.     register char *rp;    /* pointer into result */
  1184.     static char result[NSTRING];    /* temporary result */
  1185.  
  1186.     /* scan source string */
  1187.     sp = source;
  1188.     rp = result;
  1189.     while (*sp) {
  1190.         /* scan lookup table for a match */
  1191.         lp = lookup;
  1192.         while (*lp) {
  1193.             if (*sp == *lp) {
  1194.                 *rp++ = trans[lp - lookup];
  1195.                 goto xnext;
  1196.             }
  1197.             ++lp;
  1198.         }
  1199.  
  1200.         /* no match, copy in the source char untranslated */
  1201.         *rp++ = *sp;
  1202.  
  1203. xnext:        ++sp;
  1204.     }
  1205.  
  1206.     /* terminate and return the result */
  1207.     *rp = 0;
  1208.     return(result);
  1209. }
  1210.  
  1211. /*    setwlist:    Set an alternative list of character to be
  1212.             considered "in a word */
  1213.  
  1214. PASCAL NEAR setwlist(wclist)
  1215.  
  1216. char *wclist;    /* list of characters to consider "in a word" */
  1217.  
  1218. {
  1219.     register int index;
  1220.  
  1221.     /* if we are turning this facility off, just flag so */
  1222.     if (wclist == NULL || *wclist == 0) {
  1223.         wlflag = FALSE;
  1224.         return;
  1225.     }
  1226.  
  1227.     /* first clear the table */
  1228.     for (index = 0; index < 256; index++)
  1229.         wordlist[index] = FALSE;
  1230.  
  1231.     /* and for each character in the new value, set that element
  1232.        of the word character list */
  1233.     while (*wclist)
  1234.         wordlist[(unsigned char)(*wclist++)] = TRUE;    /* ep */
  1235.     wlflag = TRUE;
  1236.     return;
  1237. }
  1238.  
  1239. /*    getwlist:    place in a buffer a list of characters
  1240.             considered "in a word"            */
  1241.  
  1242. char *PASCAL NEAR getwlist(buf)
  1243.  
  1244. char *buf;    /* buffer to place list of characters */
  1245.  
  1246. {
  1247.     register int index;
  1248.     register char *sp;
  1249.  
  1250.     /* if we are defaulting to a standard word char list... */
  1251.     if (wlflag == FALSE)
  1252.         return("");
  1253.  
  1254.     /* build the string of characters in the return buffer */
  1255.     sp = buf;
  1256.     for (index = 0; index < 256; index++)
  1257.         if (wordlist[index])
  1258.             *sp++ = index;
  1259.     *sp = 0;
  1260.     return(buf);
  1261. }
  1262.  
  1263. /*    is_num: ascii string is integer......This is too
  1264.         inconsistant to use the system's    */
  1265.  
  1266. int PASCAL NEAR is_num(st)
  1267.  
  1268. char *st;
  1269.  
  1270. {
  1271.     int period_flag;    /* have we seen a period yet? */
  1272.  
  1273.     /* skip preceding whitespace */
  1274.     while (*st == ' ' || *st == '\t')
  1275.         ++st;
  1276.  
  1277.     /* check for sign */
  1278.     if ((*st == '-') || (*st == '+'))
  1279.         ++st;
  1280.  
  1281.     /* scan digits */
  1282.     period_flag = FALSE;
  1283.     while ((*st >= '0') && (*st <= '9') ||
  1284.            (*st == '.' && period_flag == FALSE)) {
  1285.         if (*st == '.')
  1286.             period_flag = TRUE;
  1287.         st++;
  1288.     }
  1289.  
  1290.     /* scan rest of line for just white space */
  1291.     while (*st) {
  1292.         if ((*st != '\t') && (*st != ' '))
  1293.             return(FALSE);
  1294.         st++;
  1295.     }
  1296.     return(TRUE);
  1297. }
  1298.  
  1299. #if    DEBUGM
  1300. int PASCAL NEAR dispvar(f, n)        /* display a variable's value */
  1301.  
  1302. int f;        /* default flag */
  1303. int n;        /* numeric arg (can overide prompted value) */
  1304.  
  1305. {
  1306.     register int status;    /* status return */
  1307.     VDESC vd;        /* variable num/type */
  1308.     char var[NVSIZE+1];    /* name of variable to fetch */
  1309.  
  1310.     /* first get the variable to display.. */
  1311.     if (clexec == FALSE) {
  1312.         status = mlreply(TEXT55, &var[0], NVSIZE+1);
  1313. /*                 "Variable to display: " */
  1314.         if (status != TRUE)
  1315.             return(status);
  1316.     } else {    /* macro line argument */
  1317.         /* grab token and skip it */
  1318.         execstr = token(execstr, var, NVSIZE + 1);
  1319.     }
  1320.  
  1321.     /* check the legality and find the var */
  1322.     findvar(var, &vd, NVSIZE + 1);
  1323.         
  1324.     /* if its not legal....bitch */
  1325.     if (vd.v_type == -1) {
  1326.         mlwrite(TEXT52, var);
  1327. /*            "%%No such variable as '%s'" */
  1328.         return(FALSE);
  1329.     }
  1330.  
  1331.     /* and display the value */
  1332.     strcpy(outline, var);
  1333.     strcat(outline, " = ");
  1334.  
  1335.     /* and lastly the current value */
  1336.     strcat(outline, fixnull(getval(var)));
  1337.  
  1338.     /* expand '%' to "%%" so mlwrite wont bitch */
  1339.     makelit(outline);
  1340.  
  1341.     /* write out the result */
  1342.     mlforce(outline);
  1343.     update(TRUE);
  1344.  
  1345.     /* and return */
  1346.     return(TRUE);
  1347. }
  1348.  
  1349. /*    describe-variables    Bring up a fake buffer and list the contents
  1350.                 of all the environment variables
  1351. */
  1352.  
  1353. PASCAL NEAR desvars(f, n)
  1354.  
  1355. int f,n;    /* prefix flag and argument */
  1356.  
  1357. {
  1358.     register BUFFER *varbuf;/* buffer to put variable list into */
  1359.     register int uindex;    /* index into uvar table */
  1360.     char outseq[256];    /* output buffer for keystroke sequence */
  1361.  
  1362.     /* and get a buffer for it */
  1363.     varbuf = bfind(TEXT56, TRUE, BFINVS);
  1364. /*           "Variable list" */
  1365.     if (varbuf == NULL || bclear(varbuf) == FALSE) {
  1366.         mlwrite(TEXT57);
  1367. /*            "Can not display variable list" */
  1368.         return(FALSE);
  1369.     }
  1370.  
  1371.     /* let us know this is in progress */
  1372.     mlwrite(TEXT58);
  1373. /*        "[Building variable list]" */
  1374.  
  1375.     /* build the environment variable list */
  1376.     for (uindex = 0; uindex < NEVARS; uindex++) {
  1377.  
  1378.         /* add in the environment variable name */
  1379.         strcpy(outseq, "$");
  1380.         strcat(outseq, envars[uindex]);
  1381.         pad(outseq, 14);
  1382.             
  1383.         /* add in the value */
  1384.         strcat(outseq, gtenv(envars[uindex]));
  1385.  
  1386.         /* and add it as a line into the buffer */
  1387.         if (addline(varbuf, outseq) != TRUE)
  1388.             return(FALSE);
  1389.     }
  1390.  
  1391.     if (addline(varbuf, "") != TRUE)
  1392.         return(FALSE);
  1393.  
  1394.     /* build the user variable list */
  1395.     for (uindex = 0; uindex < MAXVARS; uindex++) {
  1396.         if (uv[uindex].u_name[0] == 0)
  1397.             break;
  1398.  
  1399.         /* add in the user variable name */
  1400.         strcpy(outseq, "%");
  1401.         strcat(outseq, uv[uindex].u_name);
  1402.         pad(outseq, 14);
  1403.             
  1404.         /* add in the value */
  1405.         strcat(outseq, uv[uindex].u_value);
  1406.  
  1407.         /* and add it as a line into the buffer */
  1408.         if (addline(varbuf, outseq) != TRUE)
  1409.             return(FALSE);
  1410.     }
  1411.  
  1412.     /* display the list */
  1413.     wpopup(varbuf);
  1414.     mlerase();    /* clear the mode line */
  1415.     return(TRUE);
  1416. }
  1417.  
  1418. /*    describe-functions    Bring up a fake buffer and list the
  1419.                 names of all the functions
  1420. */
  1421.  
  1422. int PASCAL NEAR desfunc(f, n)
  1423.  
  1424. int f,n;    /* prefix flag and argument */
  1425.  
  1426. {
  1427.     register BUFFER *fncbuf;/* buffer to put function list into */
  1428.     register int uindex;    /* index into funcs table */
  1429.     char outseq[80];    /* output buffer for keystroke sequence */
  1430.  
  1431.     /* get a buffer for the function list */
  1432.     fncbuf = bfind(TEXT211, TRUE, BFINVS);
  1433. /*           "Function list" */
  1434.     if (fncbuf == NULL || bclear(fncbuf) == FALSE) {
  1435.         mlwrite(TEXT212);
  1436. /*            "Can not display function list" */
  1437.         return(FALSE);
  1438.     }
  1439.  
  1440.     /* let us know this is in progress */
  1441.     mlwrite(TEXT213);
  1442. /*        "[Building function list]" */
  1443.  
  1444.     /* build the function list */
  1445.     for (uindex = 0; uindex < NFUNCS; uindex++) {
  1446.  
  1447.         /* add in the environment variable name */
  1448.         strcpy(outseq, "&");
  1449.         strcat(outseq, funcs[uindex].f_name);
  1450.  
  1451.         /* and add it as a line into the buffer */
  1452.         if (addline(fncbuf, outseq) != TRUE)
  1453.             return(FALSE);
  1454.     }
  1455.  
  1456.     if (addline(fncbuf, "") != TRUE)
  1457.         return(FALSE);
  1458.  
  1459.     /* display the list */
  1460.     wpopup(fncbuf);
  1461.     mlerase();    /* clear the mode line */
  1462.     return(TRUE);
  1463. }
  1464.  
  1465. VOID PASCAL NEAR pad(s, len)    /* pad a string to indicated length */
  1466.  
  1467. char *s;    /* string to add spaces to */
  1468. int len;    /* wanted length of string */
  1469.  
  1470. {
  1471.     while (strlen(s) < len) {
  1472.                 strcat(s, "          ");
  1473.         s[len] = 0;
  1474.     }
  1475. }
  1476. #endif
  1477.